home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 19 / 64er_Magazin_Sonderheft_19_19xx_Markt__Technik_de.d64 / simplex 64 v.16 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  6KB  |  322 lines

  1. 100 rem ****************************
  2. 110 rem *                          *
  3. 120 rem *        simplex 64        *
  4. 130 rem *                          *
  5. 140 rem *            by            *
  6. 150 rem *                          *
  7. 160 rem *         m. buhtz         *
  8. 170 rem *                          *
  9. 180 rem *       grafenring 13      *
  10. 190 rem *        4230 wesel        *
  11. 200 rem *      tel.:0281/22431     *
  12. 210 rem *                          *
  13. 220 rem ****************************
  14. 230 :
  15. 240 print"[147]     simplex 64[146]":print:print
  16. 250 print"   80 zeichenkarte ? (j/n)"
  17. 260 geta$
  18. 270 ifa$="j"then w=5:goto300
  19. 280 ifa$="n"then w=1:goto300
  20. 290 goto260
  21. 300 print:print:print
  22. 310 print"   druckerausgabe ? (j/n)":print
  23. 320 geta$
  24. 330 ifa$="n"then410
  25. 340 ifa$="j"thene1=1:goto360
  26. 350 goto320
  27. 360 print"   alle loesungen ? (1)":print
  28. 370 print"   nur optimum ?    (2)"
  29. 380 gete$
  30. 390 ife$<>"1"ande$<>"2"then380
  31. 400 ife$="2"thene1=2
  32. 410 print"[147]     simplex 64[146]":print:print:print:print
  33. 420 input"   anzahl strukturvariablen ";n
  34. 430 print
  35. 440 input"   anzahl restriktionen ";m
  36. 450 m=m+1
  37. 460 print"[147]    simplex 64[146]":print:print:print:print
  38. 470 dim a(m,n),b(m,n),e(m),x$(n),x1$(n),y$(m),y1$(m)
  39. 480 print"   freie strukturvariablen ? (j/n)"
  40. 490 geta$
  41. 500 ifa$="j"thendim sp$(n) :goto 530
  42. 510 ifa$="n"then610
  43. 520 goto490
  44. 530 :
  45. 540 print"[147]    freie strukturvariablen[146]":print
  46. 550 fori=1ton
  47. 560 print"   in spalte"i"? (j/n)"
  48. 570 geta$
  49. 580 ifa$=""then570
  50. 590 ifa$="j"thensp$(i)="j"
  51. 600 nexti
  52. 610 :
  53. 620 print"[147]    simplex 64[146]":print:print:print:print
  54. 630 print"   gesperrte schlupfvariablen ? (j/n)"
  55. 640 geta$
  56. 650 ifa$="j"thendimz$(m):goto680
  57. 660 ifa$="n"then770
  58. 670 goto640
  59. 680 :
  60. 690 print"[147]    gesperrte schlupfvariablen[146]":print
  61. 700 fori=1tom-1
  62. 710 print"   in zeile"i"? (j/n)"
  63. 720 geta$
  64. 730 ifa$=""then720
  65. 740 ifa$="j"thenz$(i)="j"
  66. 750 nexti
  67. 760 :
  68. 770 rem *** eingabe koeffizienten ***
  69. 780 :
  70. 790 fori1=1tonstepw+1
  71. 800 print"[147]"
  72. 810 print,"*** simplex tableau ***" :print
  73. 820 x$(0)="rs "
  74. 830 print,
  75. 840 i2=i1+w
  76. 850 ifi2>=ntheni2=n
  77. 860 fori=i1toi2
  78. 870 x$(i)="x":x1$(i)=str$(i):x$(i)=x$(i)+x1$(i)
  79. 880 print"x"i,
  80. 890 nexti
  81. 900 ifi>nthenprint"rs ",
  82. 910 j1=j2+1
  83. 920 j2=j1+w
  84. 930 ifj2>=nthenj2=n
  85. 940 print
  86. 950 fori=0tom-1
  87. 960 y$(i)="y":y1$(i)=str$(i):y$(i)=y$(i)+y1$(i)
  88. 970 ifi=0thenprint:print;"  z";:goto1000
  89. 980 ifi=1thenprint
  90. 990 print:print;"y"i;
  91. 1000 forj=j1toj2
  92. 1010 print,;:poke19,1:inputa(i,j):poke19,0
  93. 1020 nextj
  94. 1030 ifj>nthenprint,"";:poke19,1:inputa(i,0):poke19,0
  95. 1040 nexti
  96. 1050 nexti1
  97. 1060 ife1<>0thengosub2790
  98. 1070 :
  99. 1080 rem*** phase 0' s(spalte) ***
  100. 1090 :
  101. 1100 fori=1ton
  102. 1110 ifsp$(i)="j"thens=i:sp$(i)="s":goto1170
  103. 1120 nexti
  104. 1130 goto1220
  105. 1140 :
  106. 1150 rem*** phase 0' r(zeile) ***
  107. 1160 :
  108. 1170 r=int(rnd(1)*m)+1:t=t+1
  109. 1180 ifz$(r)="s"ora(r,s)=0then1170
  110. 1190 ift>100then2440
  111. 1200 t=0:goto1850
  112. 1210 :
  113. 1220 rem*** phase 0 r(zeile) ***
  114. 1230 :
  115. 1240 fori=1tom-1
  116. 1250 ifz$(i)="j"thenr=i:z$(i)="s":goto1310
  117. 1260 nexti
  118. 1270 goto1360
  119. 1280 :
  120. 1290 rem*** phase 0 s(spalte) ***
  121. 1300 :
  122. 1310 s=int(rnd(1)*n)+1:t=t+1
  123. 1320 ifsp$(s)="s"ora(r,s)=0then1310
  124. 1330 ift>100then2530
  125. 1340 t=0:goto1850
  126. 1350 :
  127. 1360 rem *** phase 1 r(zeile) ***
  128. 1370 :
  129. 1380 s=0:r=0
  130. 1390 fori=1tom-1
  131. 1400 ifa(i,0)<0thenr=i:goto1450
  132. 1410 nexti:goto1520
  133. 1420 :
  134. 1430 rem*** phase 1 s(spalte) ***
  135. 1440 :
  136. 1450 s=int(rnd(1)*n)+1:t=t+1
  137. 1460 ift>100then2620
  138. 1470 ifa(r,s)>=0then1450
  139. 1480 ifr<>0thent=0:goto 1850
  140. 1490 :
  141. 1500 rem *** phase 2 s(spalte) ***
  142. 1510 :
  143. 1520 s=0:r=0
  144. 1530 ifa(0,1)<0thens=1
  145. 1540 forj=2ton
  146. 1550 ifa(0,j)>=0 or  a(0,j)>a(0,j-1) then 1570
  147. 1560 s=j
  148. 1570 next j
  149. 1580 ifs>0then1710
  150. 1590 ee=1
  151. 1600 ife1=2thengosub2800
  152. 1610 print
  153. 1620 print" **** rechnung beendet ****"
  154. 1630 print" ****      optimum     ****"
  155. 1640 ife1=0then1670
  156. 1650 open4,4:print#4:print#4,chr$(16)"11**** rechnung beendet ****"
  157. 1660 print#4,chr$(16)"11****      optimum     ****":print#4:close4
  158. 1670 geta$
  159. 1680 ifa$<>""then2070
  160. 1690 goto1670
  161. 1700 :
  162. 1710 rem *** phase 2 r(zeile) ***
  163. 1720 :
  164. 1730 fori=1tom-1
  165. 1740 ifa(i,s)<=0thene(i)=10^38:goto1760
  166. 1750 e(i)=a(i,0)/a(i,s)
  167. 1760 nexti
  168. 1770 ife(1)>0thenr=1:goto1790
  169. 1780 e(1)=10^38
  170. 1790 fori=2tom-1
  171. 1800 ife(i)<=0 or e(i)>=e(i-1)then 1820
  172. 1810 r=i:goto1850
  173. 1820 nexti
  174. 1830 ifr<>1then2710
  175. 1840 :
  176. 1850 rem *** umrechnung ***
  177. 1860 :
  178. 1870 zw$=x$(s):x$(s)=y$(r):y$(r)=zw$
  179. 1880 b(r,s)=1/a(r,s)
  180. 1890 :
  181. 1900 forj=0ton
  182. 1910 ifj=sthen1930
  183. 1920 b(r,j)=a(r,j)/a(r,s)
  184. 1930 nextj
  185. 1940 :
  186. 1950 fori=0tom-1
  187. 1960 ifi=rthen1980
  188. 1970 b(i,s)=-a(i,s)/a(r,s)
  189. 1980 nexti
  190. 1990 :
  191. 2000 fori=0tom-1
  192. 2010 forj=0ton
  193. 2020 ifj=s or i=rthen2040
  194. 2030 b(i,j)=a(i,j)-a(i,s)*b(r,j)
  195. 2040 nextj
  196. 2050 nexti
  197. 2060 :
  198. 2070 rem *** umgerechnetes simplex tableau ***
  199. 2080 :
  200. 2090 it=it+1
  201. 2100 i1=0:i2=0:j1=0:j2=0
  202. 2110 fori1=1tonstepw+1
  203. 2120 ifn<=w+1then2130
  204. 2130 print"[147]"
  205. 2140 print"   *** simplex tableau "it"[157].iteration ***":print
  206. 2150 print,
  207. 2160 i2=i1+w
  208. 2170 ifi2=>ntheni2=n
  209. 2180 fori=i1toi2
  210. 2190 printx$(i),
  211. 2200 nexti
  212. 2210 ifi>nthenprintx$(0)
  213. 2220 j1=j2+1
  214. 2230 j2=j1+w
  215. 2240 ifj2>=nthenj2=n
  216. 2250 fori=0tom-1
  217. 2260 print:printy$(i);
  218. 2270 forj=j1toj2
  219. 2280 a(i,j)=b(i,j)
  220. 2290 a(i,0)=b(i,0)
  221. 2300 print,"";:printint(a(i,j)*100+.5)/100;
  222. 2310 nextj
  223. 2320 ifj>nthenprint,"";:printint(a(i,0)*100+.5)/100
  224. 2330 nexti
  225. 2340 ifee<>1ori1>=nthen2370
  226. 2350 geta$
  227. 2360 ifa$=""then2350
  228. 2370 nexti1
  229. 2380 :
  230. 2390 ife1=1thengosub2790
  231. 2400 goto1070
  232. 2410 :
  233. 2420 rem *** meldungen ***
  234. 2430 :
  235. 2440 print:print" *** rechnung abgebrochen phase 0' ***"
  236. 2450 print" ***   linearkombination spalten   ***"
  237. 2460 ife1=2thengosub2800
  238. 2470 ife1=0thenend
  239. 2480 open4,4:print#4
  240. 2490 print#4,chr$(16)"11*** rechnung abgebrochen phase 0' ***"
  241. 2500 print#4,chr$(16)"11***   linearkombination spalten   ***"
  242. 2510 print#4:close4:end
  243. 2520 :
  244. 2530 print:print" *** rechnung abgebrochen phase 0 ***"
  245. 2540 print" ***   linearkombination zeilen   ***"
  246. 2550 ife1=2thengosub2800
  247. 2560 ife1=0thenend
  248. 2570 open4,4:print#4
  249. 2580 print#4,chr$(16)"11*** rechnung abgebrochen phase 0 ***"
  250. 2590 print#4,chr$(16)"11***   linearkombination zeilen   ***"
  251. 2600 print#4:close4:end
  252. 2610 :
  253. 2620 print:print" *** rechnung abgebrochen phase 1 ***"
  254. 2630 print" ***   keine zulaessige loesung   ***"
  255. 2640 ife1=2thengosub2800
  256. 2650 ife1=0thenend
  257. 2660 open4,4:print#4
  258. 2670 print#4,chr$(16)"11*** rechnung abgebrochen phase 1 ***"
  259. 2680 print#4,chr$(16)"11***   keine zulaessige loesung   ***":print#4:close4:end
  260. 2690 print#4:close4:end
  261. 2700 :
  262. 2710 print:print" *** rechnung abgebrochen phase 2 ***"
  263. 2720 print" ***   keine begrenzte loesung    ***"
  264. 2730 ife1=2thengosub2800
  265. 2740 ife1=0thenend
  266. 2750 open4,4:print#4
  267. 2760 print#4,chr$(16)"11*** rechnung abgebrochen phase 2 ***"
  268. 2770 print#4,chr$(16)"11***   keine begrenzte loesung    ***":print#4:close4:end
  269. 2780 print#4:close4:end
  270. 2790 :
  271. 2800 rem *** druckerausgabe ***
  272. 2810 :
  273. 2820 open4,4
  274. 2830 i2=0:j1=0:j2=0
  275. 2840 fori1=1tonstep4
  276. 2850 print#4,chr$(10)
  277. 2860 print#4,chr$(16)"10*** simplex tableau"it".iteration ***"
  278. 2870 print#4
  279. 2880 i2=i1+3
  280. 2890 ifi2>=ntheni2=n
  281. 2900 z=0
  282. 2910 fori=i1toi2
  283. 2920 z=z+1
  284. 2930 onzgosub3260,3270,3280,3290,3300
  285. 2940 :
  286. 2950 nexti
  287. 2960 ifi<=nthen2990
  288. 2970 i=0:z=z+1
  289. 2980 onzgosub3260,3270,3280,3290,3300
  290. 2990 j1=j2+1
  291. 3000 j2=j1+3
  292. 3010 ifj2>=nthenj2=n
  293. 3020 print#4
  294. 3030 fori=0tom-1
  295. 3040 ifi=0thenprint#4:print#4,"  z",:goto3070
  296. 3050 ifi=1thenprint#4
  297. 3060 print#4:print#4,y$(i),
  298. 3070 z=0
  299. 3080 forj=j1toj2
  300. 3090 ifit=0then3120
  301. 3100 a(i,j)=b(i,j)
  302. 3110 a(i,0)=b(i,0)
  303. 3120 z=z+1
  304. 3130 onzgosub3210,3220,3230,3240,3250
  305. 3140 nextj
  306. 3150 ifj<=nthen3180
  307. 3160 j=0:z=z+1
  308. 3170 onzgosub3210,3220,3230,3240,3250
  309. 3180 nexti
  310. 3190 nexti1
  311. 3200 print#4:close4:return
  312. 3210 print#4,chr$(16)"13"int(a(i,j)*100+.5)/100;:return
  313. 3220 print#4,chr$(16)"26"int(a(i,j)*100+.5)/100;:return
  314. 3230 print#4,chr$(16)"39"int(a(i,j)*100+.5)/100;:return
  315. 3240 print#4,chr$(16)"52"int(a(i,j)*100+.5)/100;:return
  316. 3250 print#4,chr$(16)"65"int(a(i,j)*100+.5)/100;:return
  317. 3260 print#4,chr$(16)"14"x$(i);:return
  318. 3270 print#4,chr$(16)"27"x$(i);:return
  319. 3280 print#4,chr$(16)"40"x$(i);:return
  320. 3290 print#4,chr$(16)"53"x$(i);:return
  321. 3300 print#4,chr$(16)"66"x$(i);:return
  322.